home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / Clone / TestApps / App2.f < prev    next >
Encoding:
FORTH Source  |  1992-05-31  |  1.1 KB  |  67 lines
  1. include? clone cl:topfile
  2.  
  3. anew task-App2.f
  4.  
  5.  
  6. 0 .if
  7.  
  8.     This program is useful for testing overlay CLONEing code
  9.     in that it causes CLONE to deal with forward-referencing
  10.     while tracing CFAs.
  11.  
  12. .then
  13.  
  14.  
  15. \ : GetA5   ( -- up )   up@ ;
  16.  
  17. :struct TestStruct
  18.     long    long1
  19.     long    long2
  20. ;struct
  21.  
  22. TestStruct TStruct
  23.  
  24. $ 12345678 Tstruct ..! long1
  25. $ 87654321 Tstruct ..! long2
  26.  
  27. : addme  + ;
  28.  
  29. : Someword   ( -- . just something to call, does nothing )
  30.   4 5 + dup addme
  31. ;
  32.  
  33. : .absup   ." A5 (abs) = "  up@ >abs .hex cr ;
  34.  
  35. : .relup   ." A5 (rel) = "  up@      .hex cr ;
  36.  
  37. : .Tstruct ." Tstruct  = "  Tstruct .hex cr
  38.            ." long1    = "  Tstruct dup .. long1 .hex
  39.                             ." /" ..@ long1 .hex cr
  40.            ." long2    = "  Tstruct dup .. long2 .hex
  41.                             ." /" ..@ long2 .hex cr
  42. ;
  43.  
  44. : .startword
  45.   up@ cell-  @
  46.   cr       ." Overlay exec 'A5-relative-CFA' is A5+"  .hex
  47.   cr ." 1st 32 bytes of overlay area:"  up@ cell- $ 20 dump >newline
  48. ;
  49.  
  50. : .Overlay  ( -- )
  51.   Someword
  52.   >newline
  53.   .absup
  54.   .relup
  55.   .Tstruct
  56.   .startword
  57. ;
  58.  
  59. MakeOverlay .Overlay
  60.  
  61. : App2  ( -- )
  62.   .Overlay
  63.   ' .Overlay FreeOverlay
  64. ;
  65.  
  66.  
  67.